Syntax10.Scn.Fnt
MODULE Kepler;	(* J. Templ, 27.09.93 *)
	IMPORT SYSTEM, Oberon, Texts, Files, Printer, TextFrames, MenuViewers, Viewers,
		KeplerFrames, KeplerGraphs, KeplerPorts, In;
	CONST
		menu = "System.Close  System.Copy  System.Grow  Kepler.Store";
		W: Texts.Writer;
		AttrV: MenuViewers.Viewer;
		AttrT: Texts.Text;
	PROCEDURE Print *;
		VAR
			S: Texts.Scanner;
			source: KeplerGraphs.Graph;
			V: Viewers.Viewer;
			nofcopies: INTEGER;
		PROCEDURE PrintUnit(G: KeplerGraphs.Graph; nofcopies: INTEGER);
			VAR P: KeplerPorts.PrinterPort;
		BEGIN NEW(P);
			P.X := 0; P.Y := 0; P.W := MAX(INTEGER); P.H := 3300;
			P.x0 := 0; P.y0 := 0; P.scale := 1;
			G.Draw(P);
			Printer.Page(nofcopies)
		END PrintUnit;
	BEGIN
        Texts.WriteString(W, "Kepler.Print"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
		Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
        IF S.class = Texts.Name THEN
			Printer.Open(S.s, Oberon.User, Oberon.Password);
	        IF Printer.res = 0 THEN
				Texts.Scan(S); nofcopies := 1;
				IF S.class = Texts.Int THEN nofcopies := SHORT(S.i); Texts.Scan(S) END ;
				WHILE S.class = Texts.Name DO
					source := KeplerGraphs.Old(S.s);
					IF source = NIL THEN Texts.WriteString(W, " -- not found: ");
						Texts.WriteString(W, S.s); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
					ELSE PrintUnit(source, nofcopies)
					END ;
					Texts.Scan(S)
				END;
				IF (S.class = Texts.Char) & (S.c = "*") THEN
					V := Oberon.MarkedViewer();
					IF (V IS MenuViewers.Viewer) & (V.dsc.next IS KeplerFrames.Frame) THEN
						PrintUnit(V.dsc.next(KeplerFrames.Frame).G, nofcopies)
					END
				END;
      	      Printer.Close
  	      ELSE
  	          IF Printer.res = 1 THEN Texts.WriteString(W, " no such printer")
  	          ELSIF Printer.res = 2 THEN Texts.WriteString(W, " no link")
     	       ELSIF Printer.res = 3 THEN Texts.WriteString(W, " printer not ready")
     	       ELSIF Printer.res = 4 THEN Texts.WriteString(W, " no permission")
     	       END;
    			Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
   	     END
		ELSE Texts.WriteString(W, " no printer specified");
			Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
		END
	END Print;
	PROCEDURE Open*;
		VAR
			V: MenuViewers.Viewer;
			X, Y, grid: INTEGER;
			G: KeplerGraphs.Graph;
			F: KeplerFrames.Frame;
			name: ARRAY 32 OF CHAR;
	BEGIN
		In.Open; In.Name(name);
		IF In.Done THEN In.Int(grid);
			IF ~In.Done THEN grid := 5 END ;
			Oberon.AllocateUserViewer(Oberon.Mouse.X, X, Y);
			G := KeplerGraphs.Old(name);
			IF G = NIL THEN NEW(G); G.seltime := -1 END ;
			F := KeplerFrames.New(G);
			F.grid := grid;
			V := MenuViewers.New(TextFrames.NewMenu(name, menu), F, TextFrames.menuH, X, Y)
		END
	END Open;
	PROCEDURE InitAttrV;
		VAR X, Y: INTEGER;
	BEGIN
		Texts.Delete(AttrT, 0, AttrT.len);
		IF (AttrV = NIL) OR (AttrV.state <= 0) THEN
			Oberon.AllocateSystemViewer(Oberon.Mouse.X, X, Y);
			AttrV := MenuViewers.New(
				TextFrames.NewMenu("Kepler", "System.Close  System.Grow  Kepler.Delete  Kepler.SendBack  Edit.Store"),
				TextFrames.NewText(AttrT, 0),
				TextFrames.menuH,
				X, Y)
		END
	END InitAttrV;
	PROCEDURE Constellations*;
		VAR c: KeplerGraphs.Constellation; mod, class: ARRAY 32 OF CHAR;
			sel: KeplerGraphs.Graph; minstate: INTEGER;
	BEGIN
		In.Open;
		In.Int(minstate);
		IF ~In.Done THEN minstate := 1 END ;
		KeplerFrames.GetSelection(sel);
		IF sel # NIL THEN
			InitAttrV;
			c := sel.cons;
			WHILE c # NIL DO
				IF c.State() >= minstate THEN
					Texts.WriteInt(W, SYSTEM.VAL(LONGINT, c), 10);
					Texts.WriteString(W, "  ");
					KeplerGraphs.GetType(c, mod, class);
					Texts.WriteString(W, mod);Texts.Write(W, "."); Texts.WriteString(W, class);
					Texts.WriteLn(W)
				END ;
				Texts.Append(AttrT, W.buf);
				c := c.next
			END
		END
	END Constellations;
	PROCEDURE Delete*;
		VAR
			S: Texts.Scanner; sel: KeplerGraphs.Graph;
			F: TextFrames.Frame;
			R: Texts.Reader;
			ch: CHAR;
	BEGIN
		KeplerFrames.GetSelection(sel);
		IF sel # NIL THEN
			IF AttrV # NIL THEN
				F := AttrV.dsc.next(TextFrames.Frame);
				IF F.hasSel THEN
					Texts.OpenScanner(S, AttrT, F.selbeg.org); Texts.Scan(S);
					IF S.class = Texts.Int THEN
						sel.Delete(SYSTEM.VAL(KeplerGraphs.Object, S.i));
						Texts.OpenReader(R, F.text, F.selbeg.org);
						Texts.Read(R, ch);
						WHILE (ch >= " ") OR (ch = 09X) DO Texts.Read(R, ch) END ;
						Texts.Delete(F.text, F.selbeg.org, Texts.Pos(R))
					END
				END
			END
		END
	END Delete;
	PROCEDURE Backup (VAR name: ARRAY OF CHAR);
		VAR res, i: INTEGER; bak: ARRAY 64 OF CHAR;
	BEGIN i := 0;
		WHILE name[i] # 0X DO INC(i) END ;
		IF i < 60 THEN COPY(name, bak);
			bak[i] := "."; bak[i+1] := "B"; bak[i+2] := "a"; bak[i+3] := "k"; bak[i+4] := 0X;
			Files.Rename(name, bak, res)
		END
	END Backup;
	PROCEDURE Store*;
		VAR par: Oberon.ParList;
			V: Viewers.Viewer;
			T: Texts.Text;
			S: Texts.Scanner;
            f: Files.File;
            R: Files.Rider;
            beg, end, time: LONGINT;
	BEGIN
		par := Oberon.Par; 
		IF par.frame = par.vwr.dsc THEN
			V := par.vwr; Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0)
		ELSE V := Oberon.MarkedViewer(); Texts.OpenScanner(S, par.text, par.pos)
		END;
		Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
		IF (S.class = Texts.Name) & (V.dsc # NIL) & (V.dsc.next IS KeplerFrames.Frame) THEN
			Texts.WriteString(W, "Kepler.Store ");
			Texts.WriteString(W, S.s); Texts.WriteLn(W);
			Texts.Append(Oberon.Log, W.buf);
			f := Files.New(S.s); Files.Set(R, f, 0); KeplerGraphs.Reset;
			KeplerGraphs.WriteObj(R, V.dsc.next(KeplerFrames.Frame).G);
			Backup(S.s);
			Files.Register(f)
		END
	END Store;
	PROCEDURE SetGrid*;
		VAR i: INTEGER; F: KeplerFrames.Frame; V: Viewers.Viewer;
	BEGIN
		V := Oberon.MarkedViewer();
		IF V.dsc.next IS KeplerFrames.Frame THEN
			F := V.dsc.next(KeplerFrames.Frame);
			In.Open; In.Int(i);
			IF In.Done THEN
				F.grid := i; F.Restore(F.X, F.Y, F.W, F.H)
			END
		END
	END SetGrid;
	PROCEDURE SetScale*;
		VAR F: KeplerFrames.Frame; V: Viewers.Viewer;
			X, Y, i: INTEGER;
	BEGIN
		V := Oberon.MarkedViewer();
		IF V.dsc.next IS KeplerFrames.Frame THEN
			F := V.dsc.next(KeplerFrames.Frame);
			In.Open; In.Int(i);
			IF In.Done & (i > 0) THEN
				X := Oberon.Pointer.X;
				Y := Oberon.Pointer.Y;
				F.x0 := (X - F.X) * SHORT(i) - F.Cx(X);
				F.y0 := (Y - F.Y - F.H) * SHORT(i) - F.Cy(Y);
				F.scale := i; F.Restore(F.X, F.Y, F.W, F.H)
			END
		END
	END SetScale;
	PROCEDURE Join*;
		VAR G: KeplerGraphs.Graph;
			f, s: KeplerGraphs.Star;
			c: KeplerGraphs.Constellation;
		PROCEDURE JoinCons(c: KeplerGraphs.Constellation);
			VAR i: INTEGER;
				p: KeplerGraphs.Star;
		BEGIN
			i := 0;
			WHILE i < c.nofpts DO
				p := c.p[i];
				IF p.sel & ~(p IS KeplerGraphs.Planet) & (p # f) THEN
					G.Move(p, f.x - p.x, f.y - p.y);
					c.p[i] := f; INC(f.refcnt); DEC(p.refcnt);
					IF p.refcnt = 0 THEN G.Delete(p) END
				ELSIF p IS KeplerGraphs.Planet THEN
					JoinCons(p(KeplerGraphs.Planet).c)
				END ;
				INC(i)
			END
		END JoinCons;
	BEGIN (* Join *)
		G := KeplerFrames.Focus;
		IF KeplerFrames.nofpts >= 1 THEN
			KeplerFrames.ConsumePoint(f);
			DEC(f.refcnt);
			c := G.cons;
			WHILE c # NIL DO
				JoinCons(c); c := c.next
			END ;
			G.SendToBack(f); s := f.next;
			WHILE s # NIL DO
				IF (s IS KeplerGraphs.Planet) & (s # f) THEN JoinCons(s(KeplerGraphs.Planet).c) END ;
				s := s.next
			END
		END
	END Join;
	PROCEDURE Split*;
		VAR G: KeplerGraphs.Graph;
			c: KeplerGraphs.Constellation;
			s: KeplerGraphs.Star;
		PROCEDURE SplitCons(c: KeplerGraphs.Constellation);
			VAR i: INTEGER; p, q: KeplerGraphs.Star;
		BEGIN
			FOR i := 0 TO c.nofpts - 1 DO
				p := c.p[i];
				IF p.sel THEN (* split *)
					NEW(q); c.p[i] := q;
					q^ := p^; q.refcnt := 1;
					q.next := G.stars; G.stars := q;
					DEC(p.refcnt);
					IF (p.refcnt = 0) & ~(p IS KeplerGraphs.Planet) THEN G.Delete(p) END
				END
			END
		END SplitCons;
	BEGIN (*Spit *)
		KeplerFrames.GetSelection(G);
		IF G # NIL THEN
			c := G.cons;
			WHILE c # NIL DO
				SplitCons(c);
				c := c.next
			END ;
			s := G.stars;
			WHILE s # NIL DO
				IF s IS KeplerGraphs.Planet THEN SplitCons(s(KeplerGraphs.Planet).c) END ;
				s := s.next
			END ;
		END
	END Split;
	PROCEDURE SendBack*;
		VAR
			S: Texts.Scanner; sel: KeplerGraphs.Graph;
			F: TextFrames.Frame;
	BEGIN
		KeplerFrames.GetSelection(sel);
		IF sel # NIL THEN
			IF AttrV # NIL THEN
				F := AttrV.dsc.next(TextFrames.Frame);
				IF F.hasSel THEN
					Texts.OpenScanner(S, AttrT, F.selbeg.org); Texts.Scan(S);
					IF S.class = Texts.Int THEN
						sel.SendToBack(SYSTEM.VAL(KeplerGraphs.Object, S.i));
					END
				END
			END
		END
	END SendBack;
	PROCEDURE AlignX*;
		VAR G: KeplerGraphs.Graph; s, p: KeplerGraphs.Star;
	BEGIN
		IF KeplerFrames.nofpts > 0 THEN
			KeplerFrames.GetPoint(p);
			KeplerFrames.GetSelection(G);
			s := G.stars;
			WHILE s # NIL DO
				IF s.sel & ~(s IS KeplerGraphs.Planet) THEN G.Move(s, p.x - s.x, 0) END ;
				s := s.next
			END
		END
	END AlignX;
	PROCEDURE AlignY*;
		VAR G: KeplerGraphs.Graph; s, p: KeplerGraphs.Star;
	BEGIN
		IF KeplerFrames.nofpts > 0 THEN
			KeplerFrames.GetPoint(p);
			KeplerFrames.GetSelection(G);
			s := G.stars;
			WHILE s # NIL DO
				IF s.sel & ~(s IS KeplerGraphs.Planet) THEN G.Move(s, 0, p.y - s.y) END ;
				s := s.next
			END
		END
	END AlignY;
	PROCEDURE AlignToGrid*;
		VAR V: Viewers.Viewer; F: KeplerFrames.Frame; s: KeplerGraphs.Star; X, Y: INTEGER;
	BEGIN
		V := Oberon.MarkedViewer();
		IF V.dsc.next IS KeplerFrames.Frame THEN
			F := V.dsc.next(KeplerFrames.Frame);
			IF F.grid > 0 THEN
				s := F.G.stars;
				WHILE s # NIL DO
					IF s.sel & ~(s IS KeplerGraphs.Planet) THEN
						X := F.CX(s.x); Y := F.CY(s.y);
						KeplerFrames.AlignToGrid(F, X, Y);
						F.G.Move(s, F.Cx(X) - s.x, F.Cy(Y) - s.y)
					END ;
					s := s.next
				END
			END
		END
	END AlignToGrid;
	PROCEDURE Reset*;
		VAR V: Viewers.Viewer; F: KeplerFrames.Frame;
	BEGIN
		V := Oberon.MarkedViewer();
		IF V.dsc.next IS KeplerFrames.Frame THEN F := V.dsc.next(KeplerFrames.Frame);
			F.x0 := 0; F.y0 := 0; F.scale := 4;
			F.Restore(F.X, F.Y, F.W, F.H)
		END
	END Reset;
	PROCEDURE Recall*;
	BEGIN KeplerGraphs.Recall;
	END Recall;
	PROCEDURE ScalePoints*;
		VAR sel: KeplerGraphs.Graph;
			p0, p1, p2, s: KeplerGraphs.Star;
			cx, cy, dx, dy: REAL;
	BEGIN
		KeplerFrames.GetSelection(sel);
		IF (sel # NIL) & (KeplerFrames.nofpts >= 3) THEN
			KeplerFrames.GetPoint(p0);
			KeplerFrames.GetPoint(p1);
			KeplerFrames.GetPoint(p2);
			IF p0.x = p1.x THEN cx := 1 ELSE cx := (p0.x - p2.x) / (p0.x - p1.x) END ;
			dx := p0.x - p0.x * cx; 
			IF p0.y = p1.y THEN cy := 1 ELSE cy := (p0.y - p2.y) / (p0.y - p1.y) END ;
			dy := p0.y - p0.y * cy;
			s := sel.stars;
			WHILE s # NIL DO
				IF s.sel & ~(s IS KeplerGraphs.Planet) THEN
					sel.Move(s, SHORT(ENTIER((s.x * cx + dx) - s.x)), SHORT(ENTIER((s.y * cy + dy) - s.y)))
				END ;
				s := s.next
			END
		END
	END ScalePoints;
	PROCEDURE DumpFocus*;
		VAR fp: KeplerFrames.FocusPoint;
	BEGIN
		Out.Int(KeplerFrames.nofpts); Out.Ln;
		fp := KeplerFrames.first;
		WHILE fp # NIL DO
			Out.Int(fp.p.x); Out.Int(fp.p.y);
			IF fp.p.sel THEN Out.WriteString("sel  ") ELSE Out.WriteString("~sel  ") END ;
			Out.Ln;
			fp := fp.next
		END
	END DumpFocus;
	PROCEDURE DumpGraph*;
		VAR p: KeplerGraphs.Star;
	BEGIN
		p := KeplerFrames.Focus.stars;
		Out.WriteString("seltime = "); Out.Int(KeplerFrames.Focus.seltime); Out.Ln;
		WHILE p # NIL DO
			Out.Int(p.x); Out.Int(p.y);
			IF p.sel THEN Out.WriteString("sel  ") ELSE Out.WriteString("~sel  ") END ;
			Out.Int(p.refcnt); 
			Out.Ln;
			p := p.next
		END
	END DumpGraph;
BEGIN
	Texts.OpenWriter(W);
	AttrT := TextFrames.Text("")
END Kepler.